home *** CD-ROM | disk | FTP | other *** search
/ Aminet 23 / Aminet 23 (1998)(GTI - Schatztruhe)[!][Feb 1998].iso / Aminet / dev / basic / hsb_cgx_inc.lha / hsb_cgx_inc / example / CyberGFXDemo.bas < prev    next >
BASIC Source File  |  1997-11-02  |  5KB  |  164 lines
  1. 'CyberGFXDemo.bas 0.1
  2.  
  3. 'Compiler: HBC 2.0+
  4. 'Includes: 3.1
  5. 'Author:   steffen.leistner@styx.in-chemnitz.de
  6.  
  7. DEFLNG a-z
  8.  
  9. ' $NOWINDOW
  10. ' $NOEVENT
  11. ' $NOSTACK
  12. ' $NOARRAY
  13. ' $NOLINES
  14. ' $NOVARCHECKS
  15. ' $NOAUTODIM
  16. ' $NOLIBRARY
  17. ' $UNDERLINES
  18.  
  19. ' $INCLUDE exec.bh
  20. ' $INCLUDE dos.bh
  21. ' $INCLUDE intuition.bh
  22. ' $INCLUDE utility.bh
  23. ' $INCLUDE cybergraphics.bh
  24.  
  25. CONST minver& = 37&
  26. CONST cgxver& = 40&
  27.  
  28.  
  29. FUNCTION Main&
  30.     LIBRARY OPEN "exec.library", minver&
  31.     LIBRARY OPEN "dos.library", minver&
  32.     LIBRARY OPEN "intuition.library", minver&
  33.     LIBRARY OPEN "cybergraphics.library", cgxver&
  34.  
  35.     Main& = RETURN_ERROR&
  36.     workbuf& = AllocVec& (512&, MEMF_PUBLIC& OR MEMF_CLEAR&)
  37.     IF workbuf& = NULL&
  38.         PrintMessage "Error:", "Not enough memory!", "Break"
  39.         EXIT FUNCTION
  40.     END IF
  41.     
  42.     TAGLIST workbuf&, _
  43.         CYBRBIDTG_Depth&,           24&, _
  44.         CYBRBIDTG_NominalWidth&,    640&, _
  45.         CYBRBIDTG_NominalHeight&,   480&, _
  46.     TAG_END&
  47.     modeid& = BestCModeIDTagList&(workbuf&)
  48.     
  49.     IF modeid& <> INVALID_ID&
  50.         TAGLIST workbuf&, _
  51.             SA_Width&,          640&, _
  52.             SA_Height&,         480&, _
  53.             SA_Depth&,          24&, _
  54.             SA_DisplayID&,      modeid&, _
  55.             SA_FullPalette&,    TRUE&, _
  56.             SA_Title&,          "24bit-Screen", _
  57.         TAG_END&
  58.         scr& = OpenScreenTagList&(NULL&, workbuf&)
  59.         
  60.         IF scr&
  61.             TAGLIST workbuf&, _
  62.                 WA_CustomScreen&,   scr&, _
  63.                 WA_Top&,            (PEEKW(scr& + ScreenHeight%) - 256%) \ 2, _
  64.                 WA_Left&,           (PEEKW(scr& + ScreenWidth%) - 512%) \ 2, _
  65.                 WA_InnerWidth&,     512&, _
  66.                 WA_InnerHeight&,    256&, _
  67.                 WA_GimmeZeroZero&,  TRUE&, _
  68.                 WA_CloseGadget&,    TRUE&, _
  69.                 WA_DragBar&,        TRUE&, _
  70.                 WA_SmartRefresh&,   TRUE&, _
  71.                 WA_Activate&,       TRUE&, _
  72.                 WA_Title&,          "Simple CyberGraphX-Demo", _
  73.                 WA_IDCMP&,          IDCMP_CLOSEWINDOW& OR IDCMP_VANILLAKEY&, _
  74.             TAG_END&
  75.             win& = OpenWindowTagList&(NULL&, workbuf&)
  76.             
  77.             IF win&
  78.                 rastport& = PEEKL(win& + RPort%)
  79.                 userport& = PEEKL(win& + UserPort%)
  80.                 
  81.                 argb& = NULL&
  82.                 FOR y% = 0% TO 255%
  83.                     POKEB VARPTR(argb&) + 2%, y%
  84.                     FOR x% = 0% TO 255%
  85.                         POKEB VARPTR(argb&) + 3%, x%
  86.                         junk& = WriteRGBPixel&(rastport&, x%, y%, argb&)
  87.                     NEXT x%
  88.                     FOR x% = 256% TO 511%
  89.                         POKEB VARPTR(argb&) + 1%, x% - 255%
  90.                         POKEB VARPTR(argb&) + 3%, 255% - x%
  91.                         junk& = WriteRGBPixel&(rastport&, x%, y%, argb&)
  92.                     NEXT x%
  93.                 NEXT y%
  94.                 
  95.                 DO
  96.                     sig& = xWait&((1& << PEEKB(userport& + mp_SigBit%)) OR SIGBREAKF_CTRL_C&) 
  97.                     IF sig& AND SIGBREAKF_CTRL_C& THEN
  98.                         EXIT LOOP
  99.                     ELSE
  100.                         msg& = GetMsg&(userport&)
  101.                         IF msg&
  102.                             mclass& = PEEKL(msg& + Class%)
  103.                             mcode%  = PEEKW(msg& + IntuiMessageCode%)
  104.                             ReplyMsg msg&
  105.                             
  106.                             SELECT CASE mclass&
  107.                                 CASE IDCMP_CLOSEWINDOW&
  108.                                     EXIT LOOP
  109.                                 CASE IDCMP_VANILLAKEY&
  110.                                     IF mcode% = 27% THEN
  111.                                         EXIT LOOP
  112.                                     END IF
  113.                             END SELECT
  114.                         END IF
  115.                     END IF
  116.                 LOOP
  117.                 Main& = RETURN_OK&
  118.                 CloseWindow win&
  119.  
  120.             ELSE
  121.                 PrintMessage "Error:", "Can't open Window!", "Break"
  122.             END IF
  123.             junk& = CloseScreen&(scr&)
  124.  
  125.         ELSE
  126.             PrintMessage "Error:", "Can't open Screen!", "Break"
  127.         END IF
  128.  
  129.     ELSE
  130.         PrintMessage "Error:", "Cybergraphics-modes not available!", "Break"
  131.     END IF
  132.  
  133.     FreeVec workbuf&
  134. END FUNCTION
  135.  
  136.  
  137. SUB PrintMessage (first$, second$, gadget$)
  138.     IF PEEKL(SYSTAB + 8%)
  139.         reqbufsize& = es_sizeof% + LEN(first$) + LEN(second$) + LEN(gadget$) + 4&
  140.         easystruct& = AllocVec& (reqbufsize&, MEMF_PUPLIC& OR MEMF_CLEAR&)
  141.         IF easystruct&
  142.             toffs& = easystruct& + es_sizeof%
  143.             CopyMem SADD(first$), toffs&, LEN(first$)
  144.             POKEL easystruct& + es_Title%, toffs&
  145.             toffs& = toffs& + LEN(first$) + 1&
  146.             CopyMem SADD(second$), toffs&, LEN(second$)
  147.             POKEL easystruct& + es_TextFormat%, toffs&
  148.             toffs& = toffs& + LEN(second$) + 1&
  149.             CopyMem SADD(gadget$), toffs&, LEN(gadget$)
  150.             POKEL easystruct& + es_GadgetFormat%, toffs&
  151.             junk& = EasyRequestArgs& (NULL&, easystruct&, NULL&, NULL&)
  152.             FreeVec easystruct&
  153.         END IF
  154.     ELSE
  155.         con$ = first$ + CHR$(10) + second$ + CHR$(10)
  156.         junk& = xWrite&(xOutput&, SADD(con$), LEN(con$))
  157.     END IF
  158. END SUB
  159.  
  160.  
  161. STOP Main&
  162.  
  163. DATA "$VER: CyberGFXDemo.bas 0.1 "
  164.